unit config; 

{$mode objfpc}{$H+}

interface

uses
  Classes,
  SysUtils,
  fphttp,
  httpdefs;
Type
  { TMyConfig }

  TMyConfig = class
  public
    class procedure init;
    class Procedure doGetModuleEvent (Sender : TObject; ARequest : TRequest;
                               Var ModuleClass : TCustomHTTPModuleClass);
    Procedure doOnException(Sender : TObject; E : Exception);
  end;

  { TMyURLHelper }

  TMyURLHelper = class
  public
    class function BaseUrl():string;
    class function SiteUrl(AModuleName:string;
      AActionName:string='';
      varAction:string=''):string;
  end;

procedure doShowReqException(AResponse: TResponse;
                           AnException: Exception;
                           var handled: boolean);
implementation
uses
  hadeopfmanager,
  hadebroker,
  fpfcgi,
  templateutils;

{ TMyURLHelper }

class function TMyURLHelper.BaseUrl: string;
begin
  Result:=Application.ApplicationURL;
end;

class function TMyURLHelper.SiteUrl(AModuleName: string;
  AActionName: string;
  varAction: string): string;
var
  base: String;
  varmod: String;
  varact: String;
begin
  base:= Application.ApplicationURL+'?';
  varmod := Application.ModuleVariable;
  if trim(varAction) = '' then
    varAct := 'action'
  else
    varact:= varAction;
  if trim(AActionName) = '' then
    Result:=base+varmod+'='+AModuleName
  else
    Result:=base+varmod+'='+AModuleName
            +'&'+varAct+'='+AActionName;
end;

{ TMyConfig }

class procedure TMyConfig.init;
begin
  GHadeOPFManager.ConnectionManager.RegisterConnection('test', 'test',
    '', 'SYSDBA', 'masterkey', SQLDB_Firebird);
  GHadeOPFManager.OIDStrategy := oidAutoInc;
  Application.EventLog.Active:=False;
  Application.EventLog.FileName:='log.txt';
  Application.EventLogFilter:=[etWarning,etError,etDebug];
  Application.OnGetModule:=@doGetModuleEvent;
  Application.OnShowRequestException:=@doShowReqException;
  Application.OnException:=@doOnException;
  Application.EventLog.Active:=True;
end;

class procedure TMyConfig.doGetModuleEvent(Sender: TObject; ARequest: TRequest;
  var ModuleClass: TCustomHTTPModuleClass);
begin
  Case lowercase(ARequest.query) of
  'person':ModuleClass:= ModuleFactory.ModuleByName('Person').ModuleClass;
  '': ModuleClass:= ModuleFactory.ModuleByName('Home').ModuleClass;
  end;
end;

procedure TMyConfig.doOnException(Sender: TObject; E: Exception);
begin
  Application.Log(etError,E.Message);
  Application.ShowException(E);
end;

procedure doShowReqException(AResponse: TResponse;
  AnException: Exception; var handled: boolean);
var
  errorTemplate:TErrorTemplate;
begin
  AResponse.Code:=500;
  errorTemplate:=TErrorTemplate.Create('template/error/error_general.html');
  errorTemplate.Heading:='Error';
  errorTemplate.Message:='<p>'+AnException.Message+'</p>'
                         +'<a href="'+TMyURLHelper.BaseUrl()+'">back to home page.</a>';

  Application.Log(etError,AnException.Message);
  AResponse.Contents.Add(errorTemplate.getTemplate.getContent);
  Try
    AResponse.sendContent;
  finally
    FreeAndNil(errorTemplate);
  end;
  handled:=True;
end;

initialization
  TMyConfig.init;
end.

